home *** CD-ROM | disk | FTP | other *** search
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ; ;
- ; FORTRAN 77 PRINT INTERFACE SUBROUTINE ;
- ; ;
- ; PURPOSE: ;
- ; ;
- ; To interface to the print manager. ;
- ; ;
- ; METHOD: ;
- ; ;
- ; Subroutine call from FORTRAN ;
- ; ;
- ; ARGUMENTS: ;
- ; ;
- ; Name Type Description ;
- ; ;
- ; FUNCTION INTEGER*4 Bit mask specifying function ;
- ; ARGUMENTS INTEGER*4 Arguments to print manager. ;
- ; ;
- ; CALLING SEQUENCE: ;
- ; ;
- ; CALL PRPORT(FUNCTION,ARGUMENTS) ;
- ; ;
- ; This subroutine is used with the file prport.inc, which includes ;
- ; definitions of function codes for the functions and procedures ;
- ; described in the Macintosh Print Manager manual. ;
- ; ;
- ; This file is provided for information only. An assembled version is ;
- ; available under PRPORT.SUB. ;
- ; ;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;
- ;
- ; Edit history:
- ;
- ; 06 Nov 85 Started EWG
- ; 20 Jan 86 Sent to Compuserve. EWG
-
- INCLUDE QUICKEQU.D
- INCLUDE QUICKTRAPS.D
- INCLUDE SYSEQU.D
- INCLUDE FSEQU.D
- INCLUDE SYSERR.D
- INCLUDE SYSTRAPS.D
- INCLUDE TOOLEQU.D
- INCLUDE TOOLEQUX.D
- INCLUDE TOOLTRAPS.D
- INCLUDE PREQU.D
-
- PRPORT: LEA PRPORT(PC),A5 ; Get execution address.
- CMPA.L A0,A5 ; Are we loaded into the heap?
- BMI.S L1 ; no
- MOVE.W #1,-8(A1) ; Mark this subroutine as permanent.
- L1: MOVE.L A7,A4 ; Get pointer to return address.
- MOVEM.L A0/A6,-(A7) ; Save system registers.
- MOVE.L -4(A0),A5 ; Restore Macintosh globals.
- MOVE.L D0,D7 ; Get number of arguments.
- SUBQ.L #1,D0 ; Subtract out control mask.
- LSL.L #2,D7 ; Get offset to begining of list.
- ADD.L D7,A4 ; Point to first argument.
- MOVE.L (A4),A3 ; Get pointer to control mask.
- MOVE.L (A3),D7 ; Get control mask.
- TST.L D7 ; Check for special function.
- BMI SPECIAL
-
- ; Here to process a print manager request. These are implemented as code
- ; contained in PDEF resources in the print resource file.
- MOVEQ #0,D3 ; Clear D3.
- MOVE.B D7,D3 ; Get offset to function.
- ASR.L #8,D7 ; Move function type into low byte.
- MOVEQ #0,D4 ; Clear D4.
- MOVE.B D7,D4 ; Get function type and unlock flag.
- ASR.L #8,D7 ; Move argument count into low byte.
- MOVEQ #0,D5 ; Clear D5.
- MOVE.B D7,D5 ; Get argument count.
- ASR.L #8,D7 ; Move PDEF resource number into low byte.
- MOVEQ #0,D6 ; Clear D6.
- MOVE.B D7,D6 ; Get resource number.
-
- ; Get a copy of the argument count without the unlock flag in D7 and
- ; check for the correct number of arguments passed.
- CMP.B D5,D0 ; Correct argument count?
- BEQ.S OKARGS ; yes
- MOVE.W #dsSysErr,PrintErr ; Return all-purpose error.
- BRA DONE ; Bail out.
-
- ; Get the correct PDEF resource. It is assumed that the printer resource
- ; file and the print driver have already been opened by a called to PrOpen.
- ; Resource 0 means that the print method from low memory is used as the resource number.
- ; This controls draft vs. spool printing, which are separate resources.
- OKARGS: TST.B D6 ; Resource 0?
- BNE.S PR01 ; no
- MOVE.B ChooserBits,D6 ; Get resource ID.
- ANDI.B #3,D6 ; Mask to bottom 2 bits.
- PR01: CLR.L -(A7) ; Room for a handle.
- MOVE.L #'PDEF',-(A7)
- MOVE.W D6,-(A7)
- _GetResource
- MOVE.L (A7)+,D0 ; Was the resource found?
- BNE.S RESFND ; yes
- MOVE.W #resNotFound,PrintErr ; Report error.
- BRA DONE ; Bail out.
- RESFND: MOVE.L D0,A2 ; Get handle to resource.
- MOVE.L A2,A0 ; Get a copy.
- _HLock ; Lock it.
-
- ; Make room for the result of the requested function.
- MOVE.B D4,D7 ; Save the unlock flag.
- BCLR #7,D4 ; Strip unlock flag from return type.
- TST.B D4 ; Procedure?
- BEQ.S NORET ; yes
- CMPI.B #2,D4 ; Long result?
- BEQ.S CLLONG ; yes
-
- ; Word or boolean. Push a word.
- CLR.W -(A7)
- BRA.S NORET
-
- CLLONG: CLR.L -(A7)
- NORET:
-
- ; The arguments to the requested function are on the stack in FORTRAN format.
- ; The are all longwords passed by value. The argument count is in D5.
- ; Push them on the stack for the print function.
- ; All of these functions have at least 1 argument.
- ARGLP: MOVE.L -(A4),A3 ; Get pointer to next argument.
- MOVE.L (A3),-(A7) ; Push arguement.
- SUBQ.B #1,D5 ; One less.
- BNE.S ARGLP
-
- ; Save the last argument. If this is a procedure in resource 5 then this
- ; will be a print record, and we will put the bJDocLoop in global memory
- ; so that the printing routines will know which resource (0 or 1) to read
- ; in.
- MOVE.L (A7),D5
-
- ; The code for the reqested function is in the PDEF resource read in above.
- ; Jump to it.
- MOVE.L (A2),A0 ; Dereference the handle.
- ADDA.L D3,A0 ; Add offset to routine vector.
- JSR (A0) ; Call routine.
- BTST #7,D7 ; Unlock flag set?
- BEQ.S LOCKRES ; no - leave locked.
- MOVE.L A2,A0 ; Get a copy of the handle.
- _HUNLOCK
- LOCKRES:
- ; If this was a print record setup function (in PDEF resource 4) then
- ; put the printing method into the low 2 bits of the chooser byte
- ; in low memory. This will be used by the printing functions (in
- ; PDEF resourec 0-3).
- CMPI.B #4,D6 ; Print record setup function?
- BNE.S FMTF77 ; no
- MOVE.B ChooserBits,D6 ; Get the chooser field.
- ANDI.B #$FC,D6 ; Clear out bottom 2 bits.
- MOVE.L D5,A3 ; Get the print record handle (saved above)
- MOVE.L (A3),A3 ; Dereference it.
- MOVE.B prJob+bJDocLoop(A3),D5 ; Get print method.
- ANDI.B #3,D5 ; Clear to bottom 2 bits.
- OR.B D5,D6 ; Store in chooser field.
- MOVE.B D6,ChooserBits ; Replace chooser field.
-
- ; Convert the result to FORTRAN format.
- FMTF77: TST.B D4 ; Procedure?
- BEQ.S DONE ; yes
- CMPI.B #2,D4
- BEQ.S RTLONG ; Return long word.
- BMI.S RTWORD ; Return a word.
-
- ; Here to return a boolean value. Convert to FORTRAN logical (.TRUE. =
- ; all ones; .FALSE. = all zeros).
- TST.W (A7)+ ; Test result.
- SNE D0 ; Set low byte of D0 accordingly.
- EXT.W D0
- EXT.L D0 ; Return long result in D0.
- BRA.S DONE
-
- RTLONG: MOVE.L (A7)+,D0
- BRA.S DONE
-
- RTWORD: MOVE.W (A7)+,D0
-
- DONE: MOVEM.L (A7)+,A0/A6 ; Restore system registers.
- RTS
-
- ; Process a special printer function. These are functions which are not implemented
- ; as vectors into PDEF resources from the printer resource file.
- ; D7 contains the function number.
- SPECIAL:
- EXT.L D7 ; Clear upper word.
-
- ; Tabled jump on function number.
- ADD D7,D7 ; Double type for a word offset.
- MOVE.W FUNCTAB(D7),D7 ; Get an offset to the code
- ; to process this case.
- JSR FUNCTAB(D7) ; Jump to routine.
- BRA.S DONE
-
- ; Function dispatch table.
- FUNCTAB:
- DC.W PROPEN - FUNCTAB
- DC.W PRCLOSE - FUNCTAB
- DC.W PRERROR - FUNCTAB
- DC.W PRSETERROR - FUNCTAB
-
- ; Open the print resource file and the print driver.
- PROPEN:
- ; Get the name of the print resource file from the system resource file.
- LINK A6,#-ioQElSize ; Get a parameter block.
- MOVE.L A7,A4 ; Point to the parameter block.
- MOVE.L A4,A0 ; Get a copy.
- MOVEQ #ioQElSize,D0 ; Get count to clear.
- ASR.L #1,D0 ; Divide by 2 for word count.
- SUBQ.L #1,D0 ; One less for DBF.
- CLPARM: CLR.W (A0)+ ; Clear a byte.
- DBF D0,CLPARM
-
- LEA PRNAME,A0 ; Point to the print driver name.
- MOVE.L A0,ioFileName(A4) ; Put file name in parameter block.
- MOVE.L A4,A0
- _OPEN ; Open the print driver.
-
- BSR PRRESOPEN ; Open the print resource file.
-
- OPDONE: UNLK A6 ; Deallocate parameter block.
- RTS
-
- ; Open the print resource file.
- PRRESOPEN:
- CLR.L -(A7) ; Room for handle result.
- MOVE.L #'STR ',-(A7) ; STR resource type.
- MOVE.W #$E000,-(A7) ; Resource number of print file name.
- _GetResource ; Get print file name from sys. res. file.
- MOVE.L (A7)+,D3 ; Get handle to string.
- MOVE.L D3,A0 ; Get a copy.
- _HLock ; Lock the string down.
- CLR.W -(A7) ; Room for integer result.
- MOVE.L (A0),-(A7) ; Get pointer to string.
- _OpenResFile ; Open the printer resource file.
- MOVE.L D3,A0 ; Get a copy of the string handle.
- _HUnlock ; Unlock it.
- MOVE.W (A7)+,D0 ; Get the reference number.
- BMI.S OPERR ; Error.
- RTS
- OPERR: MOVE.W ResErr,PrintErr ; Set the printer error.
- RTS
-
- PRCLOSE:
- BSR PRRESOPEN ; Make sure the file is open.
- MOVE.W D0,-(A7) ; Push reference number.
- _CloseResFile ; Close it.
- MOVE.W ResErr,PrintErr ; Set the printer error.
- CLDONE: RTS
-
- ; Return the printer error code from the system global.
- PRERROR:
- MOVE.W PrintErr,D0
- EXT.L D0
- RTS
-
- ; Set the printer error code in the system global.
- PRSETERROR:
- MOVE.L 4(A7),A1 ; Get pointer to argument.
- MOVE.L (A1),D0 ; Get argument.
- MOVE.W D0,PrintErr
- RTS
-
- ; Name of print driver.
- PRNAME: DC.B 6,'.PRINT',0
-
- END
-